home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / gui / guienv376_up1.lha / GUIEnvironment / OberonA / Source / 3rdParty / GUIEnvSupport.mod < prev   
Encoding:
Text File  |  1995-02-05  |  2.9 KB  |  98 lines
  1. (****************************************************************************
  2.  
  3. $RCSfile: GUIEnvSupport.mod $
  4.  
  5. $Revision: 1.4 $
  6.     $Date: 1994/09/29 17:50:19 $
  7.  
  8.     Some needful extra definitions and functions for GUIEnvironment
  9.  
  10.     Oberon-A Oberon-2 Compiler V5.18 (Release 1.5)
  11.  
  12.   Copyright © 1994, Carsten Ziegeler
  13.                     Augustin-Wibbelt-Str.7, 33106 Paderborn, Germany
  14.  
  15. ****************************************************************************)
  16.  
  17. <* STANDARD- *> <* MAIN- *> <*$ LongVars+ *>
  18.  
  19. MODULE GUIEnvSupport;
  20.  
  21. IMPORT SYS := SYSTEM,
  22.        E := Exec,
  23.        GT:= GadTools,
  24.        G := Graphics,
  25.        I := Intuition,
  26.        S := Strings,
  27.        U := Utility,
  28.  
  29.        GUI := GUIEnv;
  30.  
  31. VAR topazfont : G.TextAttr;
  32.  
  33. CONST
  34.  
  35. (* -------------- screen support: displayIDs ----------------------------- *)
  36.  
  37.   gesHiresPalID  * = G.hiresKey + G.palMonitorID;
  38.   gesHiresID     * = G.hiresKey + G.defaultMonitorID;
  39.   gesLoresPalID  * = G.loresKey + G.palMonitorID;
  40.   gesLoresID     * = G.loresKey + G.defaultMonitorID;
  41.  
  42.  
  43. (* -------------------------- tag data support --------------------------- *)
  44.  
  45.   gegShiftLeft   * = 256*256*256;
  46.   gegShiftTop    * = 256*256;
  47.   gegShiftWidth  * = 256;
  48.   gegShiftHeight * = 1;
  49.  
  50.   PROCEDURE GADDESC * (left, top, width, height : INTEGER) : LONGINT;
  51.   BEGIN
  52.     RETURN gegShiftLeft * left + gegShiftTop * top + gegShiftWidth * width + gegShiftHeight * height;
  53.   END GADDESC;
  54.  
  55.   PROCEDURE GADOBJS * (left, top, width, height : INTEGER) : LONGINT;
  56.   BEGIN
  57.     RETURN gegShiftLeft * left + gegShiftTop * top + gegShiftWidth * width + gegShiftHeight * height;
  58.   END GADOBJS;
  59.  
  60. (* ------------------------------- Font support ------------------------- *)
  61.  
  62.   PROCEDURE TopazAttr * ():G.TextAttrPtr;
  63.   BEGIN
  64.     topazfont.name := SYS.ADR("topaz.font");
  65.     topazfont.ySize:= 8;
  66.     RETURN SYS.ADR(topazfont);
  67.   END TopazAttr;
  68.  
  69. (* ---------------------------- Hook functions -------------------------- *)
  70.  
  71.   PROCEDURE GEUpdateEntryGadgetAHook * (hook   : U.HookPtr;
  72.                                         gadget : I.GadgetPtr;
  73.                                         unused : E.APTR) : LONGINT;
  74.   TYPE LINTPTR = POINTER TO ARRAY 2 OF LONGINT;
  75.   VAR GINFO : GUI.GUIGadgetInfoPtr;
  76.       val   : LINTPTR;
  77.       vas   : E.LSTRPTR;
  78.       info  : I.StringInfoPtr;
  79.   BEGIN
  80.     GINFO := SYS.VAL(GUI.GUIGadgetInfoPtr, gadget^.userData);
  81.     vas := SYS.VAL(E.LSTRPTR, GUI.GetGUIGadget(hook^.data, gadget^.gadgetID, GUI.gegVarAddress));
  82.     IF vas # NIL THEN
  83.       info := SYS.VAL(I.StringInfoPtr, gadget^.specialInfo);
  84.       CASE GINFO^.kind OF
  85.         GT.integerKind : val     := SYS.VAL(LINTPTR, vas);
  86.                          val^[0] := info^.longInt;
  87.                          RETURN 1;
  88.       | GT.stringKind  : vas^[0] := 0X;
  89.                          S.Insert(info^.buffer^, 0, vas^);
  90.                          RETURN 1;
  91.       ELSE
  92.       END;
  93.     END;
  94.     RETURN 0;
  95.   END GEUpdateEntryGadgetAHook;
  96.  
  97. END GUIEnvSupport.
  98.